home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / HTML / Entities.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  6.2 KB  |  221 lines
  1. package HTML::Entities;
  2.  
  3.  
  4. =head1 NAME
  5.  
  6. decode - Expand HTML entities in a string
  7.  
  8. encode - Encode chars in a string using HTML entities
  9.  
  10. =head1 SYNOPSIS
  11.  
  12.  use HTML::Entities;
  13.  
  14.  $a = "Våre norske tegn bør æres";
  15.  decode_entities($a);
  16.  encode_entities($a, "\200-\377");
  17.  
  18. =head1 DESCRIPTION
  19.  
  20. The decode_entities() routine replaces valid HTML entities found
  21. in the string with the corresponding ISO-8859/1 character.
  22.  
  23. The encode_entities() routine replaces the characters specified by the
  24. second argument with their entity representation.  The default set of
  25. characters to expand are control chars, high-bit chars and the '<',
  26. '&', '>' and '"' character.
  27.  
  28. Both routines modify the string passed in as the first argument and
  29. return it.
  30.  
  31. If you prefer not to import these routines into your namespace you can
  32. call them as:
  33.  
  34.   use HTML::Entities ();
  35.   $encoded = HTML::Entities::encode($a);
  36.   $decoded = HTML::Entities::decode($a);
  37.  
  38. The module can also export the %char2entity and the %entity2char
  39. hashes which contains the mapping from all characters to the
  40. corresponding entities.
  41.  
  42. =head1 COPYRIGHT
  43.  
  44. Copyright 1995-1997 Gisle Aas. All rights reserved.
  45.  
  46. This library is free software; you can redistribute it and/or
  47. modify it under the same terms as Perl itself.
  48.  
  49. =cut
  50.  
  51. require 5.004;
  52. require Exporter;
  53. @ISA = qw(Exporter);
  54.  
  55. @EXPORT = qw(encode_entities decode_entities);
  56. @EXPORT_OK = qw(%entity2char %char2entity);
  57.  
  58. $VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/);
  59. sub Version { $VERSION; }
  60.  
  61.  
  62. %entity2char = (
  63.  amp    => '&',  # ampersand 
  64. 'gt'    => '>',  # greater than
  65. 'lt'    => '<',  # less than
  66.  quot   => '"',  # double quote
  67.  
  68.  AElig    => '╞',  # capital AE diphthong (ligature)
  69.  Aacute    => '┴',  # capital A, acute accent
  70.  Acirc    => '┬',  # capital A, circumflex accent
  71.  Agrave    => '└',  # capital A, grave accent
  72.  Aring    => '┼',  # capital A, ring
  73.  Atilde    => '├',  # capital A, tilde
  74.  Auml    => '─',  # capital A, dieresis or umlaut mark
  75.  Ccedil    => '╟',  # capital C, cedilla
  76.  ETH    => '╨',  # capital Eth, Icelandic
  77.  Eacute    => '╔',  # capital E, acute accent
  78.  Ecirc    => '╩',  # capital E, circumflex accent
  79.  Egrave    => '╚',  # capital E, grave accent
  80.  Euml    => '╦',  # capital E, dieresis or umlaut mark
  81.  Iacute    => '═',  # capital I, acute accent
  82.  Icirc    => '╬',  # capital I, circumflex accent
  83.  Igrave    => '╠',  # capital I, grave accent
  84.  Iuml    => '╧',  # capital I, dieresis or umlaut mark
  85.  Ntilde    => '╤',  # capital N, tilde
  86.  Oacute    => '╙',  # capital O, acute accent
  87.  Ocirc    => '╘',  # capital O, circumflex accent
  88.  Ograve    => '╥',  # capital O, grave accent
  89.  Oslash    => '╪',  # capital O, slash
  90.  Otilde    => '╒',  # capital O, tilde
  91.  Ouml    => '╓',  # capital O, dieresis or umlaut mark
  92.  THORN    => '▐',  # capital THORN, Icelandic
  93.  Uacute    => '┌',  # capital U, acute accent
  94.  Ucirc    => '█',  # capital U, circumflex accent
  95.  Ugrave    => '┘',  # capital U, grave accent
  96.  Uuml    => '▄',  # capital U, dieresis or umlaut mark
  97.  Yacute    => '▌',  # capital Y, acute accent
  98.  aacute    => 'ß',  # small a, acute accent
  99.  acirc    => 'Γ',  # small a, circumflex accent
  100.  aelig    => 'µ',  # small ae diphthong (ligature)
  101.  agrave    => 'α',  # small a, grave accent
  102.  aring    => 'σ',  # small a, ring
  103.  atilde    => 'π',  # small a, tilde
  104.  auml    => 'Σ',  # small a, dieresis or umlaut mark
  105.  ccedil    => 'τ',  # small c, cedilla
  106.  eacute    => 'Θ',  # small e, acute accent
  107.  ecirc    => 'Ω',  # small e, circumflex accent
  108.  egrave    => 'Φ',  # small e, grave accent
  109.  eth    => '≡',  # small eth, Icelandic
  110.  euml    => 'δ',  # small e, dieresis or umlaut mark
  111.  iacute    => 'φ',  # small i, acute accent
  112.  icirc    => 'ε',  # small i, circumflex accent
  113.  igrave    => '∞',  # small i, grave accent
  114.  iuml    => '∩',  # small i, dieresis or umlaut mark
  115.  ntilde    => '±',  # small n, tilde
  116.  oacute    => '≤',  # small o, acute accent
  117.  ocirc    => '⌠',  # small o, circumflex accent
  118.  ograve    => '≥',  # small o, grave accent
  119.  oslash    => '°',  # small o, slash
  120.  otilde    => '⌡',  # small o, tilde
  121.  ouml    => '÷',  # small o, dieresis or umlaut mark
  122.  szlig    => '▀',  # small sharp s, German (sz ligature)
  123.  thorn    => '■',  # small thorn, Icelandic
  124.  uacute    => '·',  # small u, acute accent
  125.  ucirc    => '√',  # small u, circumflex accent
  126.  ugrave    => '∙',  # small u, grave accent
  127.  uuml    => 'ⁿ',  # small u, dieresis or umlaut mark
  128.  yacute    => '²',  # small y, acute accent
  129.  yuml    => ' ',  # small y, dieresis or umlaut mark
  130.  
  131.  copy   => '⌐',  # copyright sign
  132.  reg    => '«',  # registered sign
  133.  nbsp   => "\240", # non breaking space
  134.  
  135.  iexcl  => 'í',
  136.  cent   => 'ó',
  137.  pound  => 'ú',
  138.  curren => 'ñ',
  139.  yen    => 'Ñ',
  140.  brvbar => 'ª',
  141.  sect   => 'º',
  142.  uml    => '¿',
  143.  ordf   => '¬',
  144.  laquo  => '½',
  145. 'not'   => '¼',    # not is a keyword in perl
  146.  shy    => '¡',
  147.  macr   => '»',
  148.  deg    => '░',
  149.  plusmn => '▒',
  150.  sup1   => '╣',
  151.  sup2   => '▓',
  152.  sup3   => '│',
  153.  acute  => '┤',
  154.  micro  => '╡',
  155.  para   => '╢',
  156.  middot => '╖',
  157.  cedil  => '╕',
  158.  ordm   => '║',
  159.  raquo  => '╗',
  160.  frac14 => '╝',
  161.  frac12 => '╜',
  162.  frac34 => '╛',
  163.  iquest => '┐',
  164. 'times' => '╫',    # times is a keyword in perl
  165.  divide => '≈',
  166. );
  167.  
  168. while (($entity, $char) = each(%entity2char)) {
  169.     $char2entity{$char} = "&$entity;";
  170. }
  171.  
  172. for (0 .. 255) {
  173.     next if exists $char2entity{chr($_)};
  174.     $char2entity{chr($_)} = "&#$_;";
  175. }
  176.  
  177.  
  178. sub decode_entities
  179. {
  180.     my $array;
  181.     if (defined wantarray) {
  182.     $array = [@_]; # copy
  183.     } else {
  184.     $array = \@_;  # modify in-place
  185.     }
  186.     my $c;
  187.     for (@$array) {
  188.     s/(&\#(\d+);?)/$2 < 256 ? chr($2) : $1/eg;
  189.     s/(&\#[xX]([0-9a-fA-F]+);?)/$c = hex($2); $c < 256 ? chr($c) : $1/eg;
  190.     s/(&(\w+);?)/$entity2char{$2} || "$1;"/eg;
  191.     }
  192.     wantarray ? @$array : $array->[0];
  193. }
  194.  
  195. sub encode_entities
  196. {
  197.     my $ref;
  198.     if (defined wantarray) {
  199.     my $x = $_[0];
  200.     $ref = \$x;     # copy
  201.     } else {
  202.     $ref = \$_[0];  # modify in-place
  203.     }
  204.     if (defined $_[1]) {
  205.     unless (exists $subst{$_[1]}) {
  206.         $subst{$_[1]} =
  207.           eval "sub {\$_[0] =~ s/([$_[1]])/\$char2entity{\$1}/g; }";
  208.         die $@ if $@;
  209.     }
  210.     &{$subst{$_[1]}}($$ref);
  211.     } else {
  212.     $$ref =~ s/([^\n\t !\#\$%\'-;=?-~])/$char2entity{$1}/g;
  213.     }
  214.     $$ref;
  215. }
  216.  
  217. *encode = \&encode_entities;
  218. *decode = \&decode_entities;
  219.  
  220. 1;
  221.